home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / purdue / prob05.fcm < prev    next >
Text File  |  1993-06-26  |  3KB  |  117 lines
  1.       PROGRAM PROB05
  2. C
  3. C     PROBLEM 5
  4. C
  5. C  REFERENCE:  PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
  6. C              CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
  7. C              JOHN R. RICE, MAY 1, 1985
  8. C
  9. C              REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
  10. C
  11. C
  12. C      *************************************************
  13. C      *      Adapted for FORTRAN D benchmarking       *
  14. C      *    by  T. HAUPT  (haupt@sccs.npac.syr.edu)    *
  15. C      *                                               *
  16. C      *    Northeast Parallel Architectures Center    *
  17. C      *   at Syracuse University, Syracuse, NY, USA   *
  18. C      *************************************************
  19. C
  20. C
  21. C       VERSION SIMD/CM2-1.00
  22. C       ==================================================
  23. C
  24.       INCLUDE '/usr/include/cm/paris-configuration-fort.h'
  25.       INTEGER KASES,NS,NT
  26.       PARAMETER (KASES=5)
  27.       INTEGER N(KASES),M(KASES)
  28. cmf$  layout N (:serial)
  29. cmf$  layout M (:serial)
  30.       DATA N / 64,1024,64,256,128 /
  31.       DATA M / 128,64,1024,256,4092 /
  32.       INTEGER NABOVE
  33.       REAL AVER,AVERTOP,LOWABO
  34.       LOGICAL GENIUS
  35.  
  36.       DO 50 K = 1, KASES
  37.  
  38.       CALL CM_TIMER_CLEAR(0)
  39.       CALL CM_TIMER_START(0)
  40.  
  41.       DO MANY=1,200
  42.       NS=N(K)
  43.       NT=M(K)
  44.       CALL DOIT(NS,NT,AVER,AVERTOP,GENIUS,NABOVE,LOWABO)
  45.  
  46.       ENDDO
  47.       CALL CM_TIMER_STOP(0)
  48.  
  49.       PRINT 60, NS,NT
  50.   60  FORMAT ('PROBLEM 5 WITH ',I6,' STUDENTS AND ',I6,' TESTS')
  51.       PRINT *,'AVERAGE TEST SCORE .....:',AVER
  52.       PRINT *,'# SCORES ABOVE AVERAGE..:',NABOVE
  53.       PRINT *,'AVERAGE ABOVE ..........:',AVERTOP
  54.       PRINT *,'LOWEST SCORE ABOVE .....:',LOWABO
  55.       PRINT *,'THERE IS GENIUS ........:',GENIUS
  56.  
  57.       CALL CM_TIMER_PRINT(0)
  58.  
  59.    50 CONTINUE
  60.  
  61. c     STOP
  62.       END
  63.  
  64.       SUBROUTINE DOIT(NS,NT,AVER,AVERTOP,GENIUS,NABOVE,LOWABO)
  65.       INTEGER NABOVE
  66.       REAL AVER,AVERTOP,LOWABO
  67.       LOGICAL GENIUS
  68.       REAL, ARRAY(NT,NS) :: SCORES
  69.       LOGICAL, ARRAY(NT,NS) :: ABOVE
  70.       LOGICAL, ARRAY(NS) :: GEN_TMP
  71.  
  72.  
  73.          SCORES=60.0+40.0*SIN(SPREAD([1:NT],2,NS)*
  74.      +          SPREAD([1:NS],1,NT)*0.0006321)
  75.  
  76.          SSUM=SUM(SCORES)
  77.          AVER=SSUM/(NS*NT)
  78.  
  79.          ABOVE = (SCORES.GT.AVER)
  80.  
  81.          WHERE(ABOVE)
  82.            SCORES=SCORES*1.1
  83.          ENDWHERE
  84.  
  85.          NABOVE=COUNT(ABOVE)
  86. c        AVERTOP=SUM(SCORES,MASK=ABOVE)/NABOVE
  87. c        LOWABO=MINVAL(SCORES,MASK=ABOVE)
  88.          avertop = 0.0
  89.          lowabo = 100000.0
  90. !HPF$    independent, local_access
  91.          do j = 1, NS 
  92.             do i = 1, NT
  93.                if (above(i,j)) then
  94.                   reduce (sum, avertop, scores(i,j))
  95.                   reduce (minval, lowabo, scores(i,j))
  96.                end if
  97.             end do
  98.          end do
  99.          avertop = avertop / NABOVE
  100.  
  101. c      GENIUS=ANY(ALL(ABOVE,DIM=1))
  102. !HPF$  INDEPENDENT, LOCAL_ACCESS
  103.        do j = 1, NS 
  104. c         gen_tmp (j) = all (above(1:NT,j))
  105.           gen_tmp (j) = .true.
  106.           do i = 1, NT
  107.              gen_tmp (j) = (gen_tmp (j) .and. above(i,j))
  108.           end do
  109.        end do
  110.        GENIUS = ANY (gen_tmp)
  111.  
  112. c     RETURN
  113.       END
  114.  
  115.  
  116.  
  117.